home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
Plurals
/
ppl.emc
< prev
next >
Wrap
Lisp/Scheme
|
1992-07-05
|
26KB
|
760 lines
;
; Proper Paralation Lisp
;
; File : ppl
;
; Contents : export list: elwise
; match
; move
; depfun
; choose
; enum
; count
; position
; get
; field-ref (+ setter)
; field-length
; make-paralation
; fieldp
;
; Description : So called proper paralation lisp because it run
; on the processor array. This is better than the last
; version (plisp) as the underlying system is able
; to allocate processors in rectangles. So perhaps this
; should be bpl (better paralation lisp). This code
; rewires the given elwise form into a (hefty) piece
; of singular code with calls to parallel
; primitives.
;
; Author : SCM
;
; Change History :
;
; Date Name Comment
; 02:06:92 SCM Created - hacked from plisp.emc
; 17:06:92 SCM Added attributes slot and modified get
; Include Files
; ======= =====
; This file has to be run through a preprocessor (empp, uses cpp and sed)
; to create a EuLisp readable file. This is because it needs access to
; constants used by the data parallel lisp primitives written in mpl. The
; constants distinguish the various lisp types and the types of binary,
; unary and relational operators available.
#include "mp_arith.h"
#include "mp_type.h"
(defmodule ppl (standard0 plural ppl-ll) ()
; System Configuration
; ====== =============
; These constants are system defined, the first three indicate the number of
; physical processors available, GC-TOP varies with the size of heap.
(setq MP-Config 512)
(setq MP-X-Config 16)
(setq MP-Y-Config 32)
(setq GC-TOP (mp-sb-ref))
; Debug
; =====
; xecs are a hangover from eubang (the plurals module) and the connection
; machine lisp module which was experimentally developed before plisp,
; it is included here purely for debug purposes as it is the most
; primitive way of looking at parallel objects, which can be useful
; when something has gone wrong.
(defclass xec ()
((context
initarg context
reader context)
(offset
initarg offset
reader offset))
constructor (allocate-xec context offset)
predicate xecp)
(defun make-xec (c o)
(become-strange (allocate-xec c o)))
(defmethod generic-prin ((p xec) str)
(format str "#x(")
(mp-print (context p) (offset p) () () str)
(format str ")")
p)
(defmethod generic-write ((p xec) str)
(format str "#x(")
(mp-print (context p) (offset p) () () str)
(format str ")")
p)
; Paralation Structure
; ========== =========
; The paralation is a handle on the set of processor you are working
; on, it contains all sorts of useful information, like how many
; there are, if they have any shape.
; Fields, the data parallel objects in paralation lisp, all belong to
; one (and only one) paralation, hence they have pointer to their
; paralation structure. A special field, called the index field and
; enumerates the elements of the paralation is associated with the
; paralation and so we have a pointer to this field in the paralation
; structure as well.
; We now have the extra slot, attributes, which can be used to
; store useful information about the paralation, for example in the
; case of a rectangle its dimensions (in contexts!).
(defclass paralation-internal ()
((contexts
initarg contexts
reader contexts-internal)
(index
initarg index
accessor index-internal)
(shape
initarg shape
accessor shape-internal)
(attributes
initarg attributes
accessor attributes)
(length
initarg length
reader length-internal))
constructor (allocate-paralation contexts length))
; Paralation Object Structure
; ========== ====== =========
; Paralation objects, anything that require a paralation to make any
; sense, namely a field or a mapping, which describe communication
; patterns between fields. These all contain a paralation and a list
; of offsets into the data parallel heaps which is where the actual
; data is.
(defclass paralation-object ()
((paralation
initarg paralation
reader paralation)
(offsets
initarg offsets
accessor offsets))
predicate paralation-object-p)
; Field Structure
; ===== =========
; First we deal with fields. Notice that we wrap the field allocator
; with a form which marks the structure as being strange, this is so
; the GCer can spot tyhem and list them so we can tell the MasPar
; which of it's objects are still around.
(defclass field (paralation-object)
()
constructor (allocate-field paralation offsets)
predicate fieldp)
(defun make-field (p o)
(become-strange (allocate-field p o)))
; The paralation contains the data we are interested in, but in
; general we have the field structures, so here are functions to get
; the appropriate values from a field structure.
(defun contexts (p-o) (contexts-internal (paralation p-o)))
(defun index (p-o) (index-internal (paralation p-o)))
(defun shape (p-o) (shape-internal (paralation p-o)))
((setter setter) shape (lambda (f v)
((setter shape-internal) (paralation f) v)))
(defun field-length (p-o) (length-internal (paralation p-o)))
; Notice how these methods use a combination of immediate and indirect
; accessors, anyway - now we can print them.
(defmethod generic-prin ((f field) str)
(if (not (attributes (paralation f)))
(progn
(format str "#F(")
(mp-print (car (contexts f)) (car (offsets f)) () () str)
(if (cdr (contexts f)) (format str "... )") (format str ")")))
(let ((context-width (min (vector-ref (attributes (paralation f)) 0) MP-X-Config)))
(format str "\n#F(")
(mp-print (car (contexts f)) (car (offsets f)) context-width
(< context-width (vector-ref (attributes (paralation f)) 0)) str)
(if (< MP-Y-Config (vector-ref (attributes (paralation f)) 1))
(format str "\n ... )") (format str " )")))))
(defmethod generic-write ((f field) str)
(if (not (attributes (paralation f)))
(progn
(format str "#F(")
(mp-print (car (contexts f)) (car (offsets f)) () () str)
(if (cdr (contexts f)) (format str "... )") (format str ")")))
(let ((context-width (min (vector-ref (attributes (paralation f)) 0) MP-X-Config)))
(format str "\n#F(")
(mp-print (car (contexts f)) (car (offsets f)) context-width
(< context-width (vector-ref (attributes (paralation f)) 0)) str)
(if (< MP-Y-Config (vector-ref (attributes (paralation f)) 1))
(format str "\n ... )") (format str " )")))))
; (defmethod generic-prin ((f field) str)
; (format str "#F(")
; (mapcar (lambda (c o) (mp-print c o () () str)) (contexts f) (offsets f))
; (format str ")")
; f)
;
; (defmethod generic-write ((f field) str)
; (format str "#F(")
; (mapcar (lambda (c o) (mp-print c o () () str)) (contexts f) (offsets f))
; (format str ")")
; f)
; Processor Management
; ========= ==========
; Paralation Lisp abstracts the number of processors, it does this by
; having a list of contexts on which the paralation is allocated, data
; parallel operations are run on each of these one after another.
; A context will be a collection of global contexts, that is ones that
; use the entire array and one that uses only part of the array. We
; reuse the same global context and pre-allocate it.
(setq MP-Context (mp-make-context MP-X-Config MP-Y-Config))
(setq MP-Offsets (cons (mp-scan-op MP-Context (mp-set MP-Context
(mp-bang MP-Context 1)
0 0)
MP_PLUS) ()))
(setq MP-Nil (mp-bang MP-Context ()))
; This will ensure the global context is garbage collected as we have
; nailed it into the environment in a form that can be spotted by the
; collector.
(setq GC-Protect (list (make-xec MP-Context (car MP-Offsets))
(make-xec MP-Context MP-Nil)))
; As we allocate large paralations we reuse exisiting indexes for the
; global context compontents, the two variables below are useful for
; keeping track of these things and manipulating them in parallel
(setq VMP-Config MP-Config)
(setq PMP-Config (mp-bang MP-Context MP-Config))
(setq GC-Protect (cons (make-xec MP-Context PMP-Config) GC-Protect))
; As more virtual pes are allocated we need to number them, we reuse
; the enumerations of the global contexts as they are the same for all
; paralations and are immutable. Each time another gklobal context is
; needed produce an enumeration for it (m -> m + config -1)
(defun enough-virtual-pes-p
;; determines wether more enumerations of the global context are needed
(required) (< required (+ VMP-Config MP-Config)))
(defun more-processors (required)
;; if needed allocates more enumerations of the global context
(labels ((find-last (offsets)
;; descends list of enumerations to the last cons cell
;; extra enumerations are then tagged onto the list
(if (cdr offsets) (find-last (cdr offsets))
((setter cdr) offsets (make-rest (car offsets)))))
(make-rest (offset)
;; creates list of as many other enumeration nodes as required
;; and GC protects them
(if (enough-virtual-pes-p required) ()
(let ((new-ofst (mp-bin-op MP-Context offset
PMP-Config MP_PLUS)))
(setq VMP-Config (+ VMP-Config MP-Config))
(setq GC-Protect (cons (make-xec MP-Context new-ofst)
GC-Protect))
(cons new-ofst (make-rest new-ofst))))))
(find-last MP-Offsets)))
(defun make-hacked-context (size)
(if (= size 1) (mp-make-context 1 1)
(let* ((width (ceiling (sqrt (/ size 2))))
(ctxt (mp-make-context width (ceiling (/ (* 1.0 size) width))))
(ofst (mp-context ctxt))
(tmp-pspace (mp-ps-ref))
(dummy (mp-sb-set tmp-pspace))
(enum (mp-scan-op ctxt (mp-bang ctxt 1) MP_PLUS)))
(mp-if ctxt (mp-rel-op ctxt enum (mp-bang ctxt size) MP_LE))
(mp-else ctxt)
(mp-assign ctxt ofst (mp-bang ctxt '(() ())))
(mp-fi ctxt)
(mp-ps-set tmp-pspace)
(mp-sb-set GC-TOP)
ctxt)))
(defun get-contexts (required)
;; allocates contexts for a new paralation, creates new global
;; contexts if needed and probably one partial context unigue to
;; this paralation
(if (not (enough-virtual-pes-p required)) (more-processors required) ())
(labels ((list-of-ctxts (allocated)
;; generates the appropriate list of contexts
(if (>= (+ allocated MP-Config) required)
(list (make-hacked-context (- required allocated)))
(cons MP-Context (list-of-ctxts (+ allocated MP-Config))))))
(list-of-ctxts 0)))
(defun number-segment (ctxt ofst start)
(mp-assign ctxt ofst (mp-bang ctxt 1))
(mp-set ctxt ofst 0 start)
(mp-assign ctxt ofst (mp-scan-op ctxt ofst MP_PLUS)))
(defun get-offsets (contexts)
;; allocates enumeration offsets for the new paralation with the
;; given contexts, the global context enumerations are pulled from
;; teh list of shared enumerations, a sopecial enumeration is
;; allocated for the straggly bit at the end. get-contexts will
;; have alloacted the extra virtual processors if needed
(labels ((list-of-ofsts (contexts offsets allocated)
;; generate the appropriate list of offsets
(cond
((null contexts) ())
((eq (car contexts) MP-Context)
(cons (car offsets)
(list-of-ofsts (cdr contexts) (cdr offsets)
(+ allocated MP-Config))))
(t (list (number-segment (car contexts)
(mp-make-plural (car contexts))
allocated))))))
(list-of-ofsts contexts MP-Offsets 0)))
(defcondition illegal-operation ())
; Creating a paralation means create the index field for a new
; paralation which is what we do here.
(defun make-paralation (size)
(if (< size 1) (error "Cannot create empty paralation" illegal-operation)
(let ((new-field (make-field (allocate-paralation (get-contexts size)
size) 'no-offsets)))
((setter offsets) new-field (get-offsets (contexts new-field)))
((setter index-internal) (paralation new-field) new-field)
new-field)))
; Obvious operations
; ======= ==========
(defun field-ref (f i)
(let ((list-index (/ i MP-Config)))
(mp-ref (list-ref (contexts f) list-index)
(list-ref (offsets f) list-index) (remainder i MP-Config))))
((setter setter) field-ref (lambda (f i v)
(let ((list-index (/ i MP-Config)))
(mp-set (list-ref (contexts f) list-index)
(list-ref (offsets f) list-index) (remainder i MP-Config) v)
f)))
; And field-length is now a slot accessor!
; Operation Overview
; ========= ========
; Because the same piece of parallel code will have to run on several
; different contexts the code generated references a global called
; The-Context, mapping the code across the contexts with the first
; operation being Set-The-Context will neatly allow us to do this
; Primitives
; ==========
; These are the operations which wrap all the functions in the plural
; module which is implemenmted in C and mpl, the parallel versions of
; the functions are generated by macros which can be found in ppl-ll.em
(p-1-fn mp-un-op negate MP_NEGATE)
(p-1-fn mp-un-op abs MP_ABS)
(p-2-fn mp-eq eq ())
(p-2-fn mp-cons cons ())
(p-1-fn mp-car car ())
(p-1-fn mp-cdr cdr ())
(p-1-fn mp-make-vector make-vector())
(p-1-fn mp-vector-length vector-length ())
(p-2-fn mp-vector-ref vector-ref ())
(p-1-fn mp-test consp MP_CONS)
(p-1-fn mp-test intp INTEGER)
(p-1-fn mp-test floatp MP_FLOAT)
(p-1-fn mp-test vectorp MP_VECTOR)
(p-2-fn mp-bin-op binary-plus MP_PLUS)
(p-2-fn mp-bin-op + MP_PLUS)
(p-2-fn mp-bin-op binary-difference MP_DIFFERENCE)
(p-2-fn mp-bin-op - MP_DIFFERENCE)
(p-2-fn mp-bin-op binary-times MP_TIMES)
(p-2-fn mp-bin-op * MP_TIMES)
(p-2-fn mp-bin-op binary-divide MP_DIVIDE)
(p-2-fn mp-bin-op / MP_DIVIDE)
(p-2-fn mp-rel-op binary-gt MP_GT)
(p-2-fn mp-rel-op > MP_GT)
(p-2-fn mp-rel-op binary-lt MP_LT)
(p-2-fn mp-rel-op < MP_LT)
(p-2-fn mp-bin-op remainder MP_REMAINDER)
(p-0-fn mp-random c-rand ())
(p-2-fn mp-and and ())
(p-2-fn mp-or or ())
(p-1-fn mp-not not ())
(p-2-fn mp-assign setq ())
(p-3-set mp-vector-set vector-ref ())
(p-2-set mp-rplac-a car ())
(p-2-set mp-rplac-d cdr ())
; There are a few lisp functions who work in parallel - this is a hack!
((setter table-ref) pfun-table 'progn (cons 'progn ()))
; Elwise
; ======
; The-Context hackery, global binding and a function to set it so that
; this can be exported.
(setq The-Context 'none)
(defun Set-The-Context (v) (setq The-Context v))
; The heart of the rewriting operation, pull the appropriate functions
; out og the pfun-tables, bangs singular values with special hackery
; for cond, let, lambda and if.
(defun rewire (form)
(cond
((consp form)
(cond
((eq (car form) 'quote) (list 'mp-bang 'The-Context form))
((eq (car form) (car function-name)) (cons (cadr function-name)
(rewire (cdr form))))
((eq (car form) 'if) (elwise-if (cadr form) (caddr form) (cadddr form)))
((eq (car form) 'setter) (car (get-psetter (cadr form))))
((eq (car form) 'cond) (cons 'let (cons '((cond-result
(mp-make-plural The-Context)))
(cons '(mp-if The-Context (mp-bang The-Context t))
(rewire-cond (cdr form))))))
((eq (car form) 'lambda) (rewire-lambda (cdr form)))
((eq (car form) 'let) (rewire-let (cdr form)))
(t (cons (if (car form) (rewire (car form)) MP-Nil)
(rewire (cdr form))))))
((numberp form) (list 'mp-bang 'The-Context form))
((memq form arg-list) form)
((get-pfun form) (car (get-pfun form)))
((null form) ())
(t (list 'mp-bang 'The-Context form))))
(defun rewire-cond (form)
(if (null form) '((mp-fi The-Context) cond-result)
(cons
(list 'if (list 'mp-if 'The-Context (rewire (caar form)))
(list 'mp-assign 'The-Context
'cond-result(rewire (cadar form))) ())
(cons '(mp-file The-Context)
(rewire-cond (cdr form))))))
(defun rewire-let (form)
(let ((old-arg-list arg-list))
(setq arg-list (append (mapcar car (car form)) arg-list))
(let ((r-form (list 'let (mapcar (lambda (n-f-p)
(cons (car n-f-p)
(rewire (cdr n-f-p))))
(car form)) (cons 'progn (mapcar rewire
(cdr form))))))
(setq arg-list old-arg-list)
r-form)))
(defun rewire-lambda (form)
(let ((old-arg-list arg-list))
(setq arg-list (append (car form) arg-list))
(let ((r-form (list 'lambda (car form) (rewire (cadr form)))))
(setq arg-list old-arg-list)
r-form)))
(defun elwise-if (bool then else)
(let ((then (if then (rewire then) MP-Nil))
(else (if else (rewire else) MP-Nil)))
(list 'let '((if-result (mp-make-plural The-Context)))
(list 'if (list 'mp-if 'The-Context (rewire bool))
(list 'mp-assign 'The-Context 'if-result then) ())
(list 'if (list 'mp-else 'The-Context)
(list 'mp-assign 'The-Context 'if-result else) ())
'(mp-fi The-Context)
'if-result)))
; This function is responsible for creating the code which sets
; everything up before the parallel code is ionvoked, creates bindings
; to offsets into the data parallel heap rather than front-end
; structures, code to evaluate any let forms in the elwise parameter
; list and extracts the book-keeping info (namely the paralation
; structure) from one of the parameter fields.
; It also sets up the arg-list, that is the list of parameter field
; which are kept in a globally accessible place so we can spot when we
; don't need to bang something.
(defun eval-arg-list (arg-form)
(if (null arg-form)
(list (list 'the-contexts (list 'contexts (car arg-list)))
(list 'the-paralation (list 'paralation (car arg-list)))
'(the-offsets (mapcar mp-make-plural the-contexts))
'(the-result (make-field the-paralation the-offsets)))
(if (consp (car arg-form))
(progn
(setq arg-list (cons (caar arg-form) arg-list))
(cons (car arg-form) (eval-arg-list (cdr arg-form))))
(progn
(setq arg-list (cons (car arg-form) arg-list))
(eval-arg-list (cdr arg-form))))))
(defun extract-offsets (arg-list)
;; gets the offset lists from each of the elwise parameter fields,
;; these oo are spliced into the rewritten code.
(mapcar (lambda (f) (list `offsets f)) arg-list))
(defmacro elwise (arg-form body)
;; And this is the hoopty-hoopty-doo-do macro itself which puts
;; all the bits in the write place.
(setq arg-list ())
(setq function-name '(none))
`(let* ,(eval-arg-list arg-form)
(mapcar (lambda ,(cons `the-context
(cons 'result-ofst arg-list))
(let ((tmp-pspace (mp-ps-ref)))
(mp-sb-set tmp-pspace)
(Set-The-Context the-context)
(mp-assign The-Context result-ofst
,(if body (rewire body)
(list 'mp-bang 'The-Context ())))
(mp-sb-set GC-TOP)
(mp-ps-set tmp-pspace)
result-ofst))
,@(cons `the-contexts (cons `the-offsets
(extract-offsets arg-list))))
the-result))
; to add primitives, particularly recursive primitives
(defmacro depfun (name args body)
(setq arg-list args)
(setq function-name (list name (make-pfun-name name)))
(add-pfun name (cadr function-name) args)
`(progn (defun ,(cadr function-name) ,args ,(rewire body))
(export ,(cadr function-name))))
; Mappings
; ========
; Mappings describe communication bewteen paralations. They are a
; special kind of plural. Without virtualisation they are easy to
; understand. Each element of the paralation contains a list of
; processor numbers which an object should be taken from. In the
; virtualisation we have to handle the mxn combinations of contexts,
; hence rather than a list of offsets, we have a list of lists of
; offsets , which gives us all the informationwe need.
(defclass mapping (paralation-object)
()
constructor (make-mapping paralation offsets)
predicate mappingp)
(defun allocate-mapping (p o)
(become-strange (make-mapping p o)))
; Communications
; ==============
; Strictly speaking anything which isn't elwise I guess
; Match
; =====
; This is indeed a most nasty operation, zipping along lists of
; contexts and offsets at slightly different rates, not turning down a
; cdr, suddenly dropping dead of myxamatosis!
(defun match (dest from)
(let ((result (allocate-mapping
(paralation dest)
(mapcar (lambda (d-c) (mapcar (lambda (f-c)
(mp-make-plural d-c))
(contexts from)))
(contexts dest))))
(tmp-pspace (mp-ps-ref)))
(mp-sb-set tmp-pspace)
(labels ((seg-match (d-ctxt d-ofst r-ofsts ctxts ofsts)
(if (null ctxts) ()
(progn
(mp-assign d-ctxt (car r-ofsts)
(mp-match d-ctxt d-ofst (car ctxts) (car ofsts)))
(seg-match d-ctxt d-ofst (cdr r-ofsts)
(cdr ctxts) (cdr ofsts))))))
(mapcar (lambda (c o r)
(seg-match c o r (contexts from) (offsets from)))
(contexts dest) (offsets dest) (offsets result))
(mp-ps-set tmp-pspace)
(mp-sb-set GC-TOP)
result)))
; Move, several levels of move so that get and choose etc can make use
; of the appropriate bits.
(defun ll-move (data map initial)
;; low-level move operation,
(mapcar
(lambda (m-ctxt m-ofsts i-ofst)
(mapcar (lambda (d-ctxt d-ofst m-ofst)
(mp-move d-ctxt d-ofst m-ctxt m-ofst i-ofst))
(contexts data) (offsets data) m-ofsts))
(contexts map) (offsets map) (offsets initial))
(offsets initial))
; The real meat of the operation, exceptionally nasty as this is what
; handles the nxm combinations between two virtual sets of
; communicating processors
(defun l-move (data map p-with default)
(labels ((recurse (l-ofst cdrl-ofst)
(if (not (mp-if The-Context cdrl-ofst)) ()
(mp-assign The-Context l-ofst
(p-with (mp-car The-Context l-ofst)
(recurse cdrl-ofst
(mp-cdr The-Context cdrl-ofst)))))
(mp-else The-Context)
(mp-assign The-Context l-ofst (mp-car The-Context l-ofst))
(mp-fi The-Context)
l-ofst))
(let ((result (make-field (paralation map)
(mapcar mp-make-plural (contexts map))))
(tmp-pspace (mp-ps-ref)))
(mp-sb-set tmp-pspace)
(mapcar (lambda (ctxt ofst)
(mp-ps-set tmp-pspace)
(Set-The-Context ctxt)
(mp-if ctxt ofst)
(recurse ofst (mp-cdr The-Context ofst))
(mp-else ctxt)
(mp-assign ctxt ofst (mp-bang ctxt default))
(mp-fi ctxt)
ofst)
(contexts map) (ll-move data map result))
(mp-ps-set tmp-pspace)
result)))
(defmacro move (data map with default)
`(l-move ,data ,map ,(rewire with) ,default))
; Shaped paralations.
; ====== ===========
; A shaped paralation has a predefined set of mappings which
; specify the neighbours of each element, get can be thought of as
; "each element takes it's value from the element in the given
; direction", the mappings are held in a vector in the shape slot of
; the paralation, and are extracted by the given token, e.g. N = 0.
; We need to extend this to support shapes which do not use
; mappings, for examle rectangles making use of the nearest neighbour
; communication network of the underlying architecture. To do this we
; simply place the functions which do the move and apply this to the
; field.
(defun get (direction f default)
(let* ((map (vector-ref (shape f) direction))
(result (if (not (mappingp map)) (elwise (f) f)
(make-field (paralation f) (mapcar mp-make-plural
(contexts f)))))
(tmp-pspace (mp-ps-ref)))
(mapcar (lambda (c o)
(mp-sb-set tmp-pspace)
(mp-if c o) (mp-assign c o (mp-car c o))
(mp-else c) (mp-assign c o (mp-bang c default))
(mp-fi c)
(mp-ps-set tmp-pspace)
o)
(contexts f) (if (mappingp map) (ll-move f map result) (map result)))
(mp-sb-set GC-TOP)
result))
(defun enum-ll (bool-f)
(let ((result (elwise (bool-f) (if bool-f 1 0)))
(tmp-pspace (mp-ps-ref)))
(labels ((recurse (c-s o-s s)
(mp-assign (car c-s) (car o-s)
(mp-bin-op (car c-s)
(mp-scan-op (car c-s)
(car o-s) MP_PLUS)
(mp-bang (car c-s) s) MP_PLUS))
(if (null (cdr c-s)) ()
(recurse (cdr c-s) (cdr o-s)
(mp-ref (car c-s) (car o-s) (- MP-Config 1))))))
(mp-sb-set tmp-pspace)
(recurse (contexts result) (offsets result) 0)
(mp-ps-set tmp-pspace)
(mp-sb-set GC-TOP)
result)))
(defun enum (bool-f)
(elwise (bool-f (new (enum-ll bool-f))) (if bool-f (- new 1) ())))
(defun choose (bool-f)
(let ((tmp (enum-ll bool-f)))
(match (make-paralation (field-ref tmp (- (field-length bool-f) 1)))
(elwise (tmp bool-f) (if bool-f (- tmp 1) ())))))
(defun count (bool-f)
(field-ref (enum-ll bool-f) (- (field-length bool-f) 1)))
(defun position (f o)
(let* ((tmp (elwise (f (i (index f))) (if (eq f o) i ())))
(tmp-pspace (mp-ps-ref))
(t-o (progn (mp-sb-set tmp-pspace) (mp-bang MP-Context 32768))))
(labels ((recurse (c-s o-s last)
(cond
((null c-s) ())
((not (mp-if (car c-s) (car o-s)))
(progn (mp-fi (car c-s))
(recurse (cdr c-s) (cdr o-s) (- last MP-Config))))
(t (progn
(mp-assign (car c-s) t-o (car o-s))
(mp-fi (car c-s))
(mp-ref (car c-s) (mp-scan-op (car c-s) t-o MP_MIN)
(if (>= last MP-Config) (- MP-Config 1)
(- last 1))))))))
(let ((result (recurse (contexts f) (offsets tmp) (field-length f))))
(mp-sb-set GC-TOP)
(mp-ps-set tmp-pspace)
result))))
(export depfun elwise match move make-paralation field-ref contexts offsets
index shape make-field Set-The-Context The-Context GC-TOP position
l-move choose enum count get fieldp field-length paralation
allocate-xec allocate-paralation index-internal rewire
shape-internal attributes paralation-internal
MP-Config MP-X-Config MP-Y-Config)
)